home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
The World of Computer Software.iso
/
opsprd.zip
/
OPSPREAD.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-10-19
|
19KB
|
596 lines
{$R-,S-,I-,V-,B-,F+,O+,A-}
{Conditional defines that may affect this unit}
{$I OPDEFINE.INC}
{*********************************************************}
{* OPSPREAD.PAS 1.20 *}
{* Copyright (c) TurboPower Software 1992. *}
{* All rights reserved. *}
{*********************************************************}
unit OpSpread;
{-Spreadsheet-like pick lists}
interface
uses
OpInline,
OpString,
OpConst, {!!.20}
OpRoot,
OpCrt,
{$IFDEF UseMouse}
OpMouse,
{$ENDIF}
OpCmd,
OpFrame,
OpWindow,
{$IFDEF UseDrag}
OpDrag,
{$ENDIF}
OpPick;
const
{---- Orientation code for a SpreadList ----}
pkSpread = 4;
{---- Stream codes for a SpreadList ----}
otSpreadList = 998;
veSpreadList = 0;
ptPickSpread = 998;
type
SpreadListPtr = ^SpreadList;
SpreadList =
object(PickList)
slRows : Word;
slCols : Word;
constructor Init(X1, Y1, X2, Y2 : Byte;
ItemWidth : Byte;
NumRows : Word;
NumCols : Word;
StringProc : pkStringProc;
CommandHandler : pkGenlProc);
{-Initialize a spreadsheet list}
constructor InitCustom(X1, Y1, X2, Y2 : Byte;
var Colors : ColorSet;
Options : LongInt;
ItemWidth : Byte;
NumRows : Word;
NumCols : Word;
StringProc : pkStringProc;
CommandHandler : pkGenlProc);
{-Initialize a spreadsheet list with custom window options}
constructor InitAbstract(X1, Y1, X2, Y2 : Byte;
var Colors : ColorSet;
Options : LongInt;
ItemWidth : Byte;
NumRows : Word;
NumCols : Word;
CommandHandler : pkGenlProc);
{-Constructor to be called by derived types that override
the ItemString method}
constructor InitDeluxe(X1, Y1, X2, Y2 : Byte;
var Colors : ColorSet;
Options : LongInt;
ItemWidth : Byte;
NumRows : Word;
NumCols : Word;
StringProc : pkStringProc;
CommandHandler : pkGenlProc;
PickOptions : Word);
{-Initialize a spread list with custom window and pick options}
constructor InitAbstractDeluxe(X1, Y1, X2, Y2 : Byte;
var Colors : ColorSet;
Options : LongInt;
ItemWidth : Byte;
NumRows : Word;
NumCols : Word;
CommandHandler : pkGenlProc;
PickOptions : Word);
{-Constructor to be called by derived types that override the
ItemString method, with custom pick options}
function GetItemRow(Item : Word) : Word;
{-Return the absolute row position of the item}
function GetItemCol(Item : Word) : Word;
{-Return the absolute column position of the item}
function GetItemNum(Row, Col : Word) : Word;
{-Return the item number corresponding to Row and Col}
procedure TopLeftRowCol(var Row, Col : Word);
{-Return the Row and Col of the top left item}
{-These routines generate an error in a SpreadList}
procedure ChangeNumItems(NumItems : Word);
{-Change the number of items to display}
procedure ChangeOrientation(Orientation : pkGenlProc);
{-Change the orientation}
{$IFDEF UseStreams}
constructor Load(var S : IdStream);
{-Load a spread list from a stream}
procedure Store(var S : IdStream);
{-Store a spread list in a stream}
{$ENDIF}
{++++ for internal use ++++}
{.Z+}
procedure pkInitPickSize1; virtual;
function pkProcessCursorCommand(var Cmd : Word) : Boolean; virtual;
{.Z-}
end;
{$IFDEF UseStreams}
{---- Stream registration ----}
procedure SpreadListStream(SPtr : IdStreamPtr);
{-Register all types needed for streams containing spread lists}
{$ENDIF}
{.Z+}
{---- Orientation routine used for spread lists ----}
procedure PickSpread(P : PickListPtr);
{-Orientation initialization for spreadsheet-like picklists}
{.Z-}
{====================================================================}
implementation
function GetSpread(First, Row, Col : Word; P : PickListPtr) : Word;
{-Get item number given <First, Row, Col>}
begin
with SpreadListPtr(P)^ do
GetSpread := First+(Col-1)+(Row-1)*slCols;
end;
procedure SetSpread(Choice, First : Word; P : PickListPtr);
{-Set valid <pkFirst, pkRow, pkCol> given Choice and First}
var
FirstRow : Word;
FirstCol : Word;
begin
with SpreadListPtr(P)^ do begin
pkChoice := Choice;
pkFirst := First;
pkCommonValidation;
{Force pkFirst into a valid range}
FirstRow := GetItemRow(pkFirst);
if FirstRow+pkHeight-1 > pkItemRows then begin
dec(pkFirst, (FirstRow+pkHeight-1-pkItemRows)*slCols);
FirstRow := GetItemRow(pkFirst);
end;
FirstCol := GetItemCol(pkFirst);
if FirstCol+pkCols-1 > slCols then begin
dec(pkFirst, FirstCol+pkCols-1-slCols);
FirstCol := GetItemCol(pkFirst);
end;
{Assure pkFirst is in a range to make pkChoice visible}
{And compute row and column}
pkRow := GetItemRow(pkChoice)-FirstRow+1;
if pkRow > pkHeight then begin
inc(pkFirst, (pkRow-pkHeight)*slCols);
pkRow := pkHeight;
end;
pkCol := GetItemCol(pkChoice)-FirstCol+1;
if pkCol > pkCols then begin
inc(pkFirst, pkCol-pkCols);
pkCol := pkCols;
end;
end;
end;
procedure ReinitSpread(P : PickListPtr);
{-Reinitialize some fields based on width, height and orientation}
var
MaxRow : Word;
MaxCol : Word;
begin
with SpreadListPtr(P)^ do begin
{pkMaxFirst controls how much scrolling, if any, is possible}
pkMaxFirst := (pkItemRows-pkHeight)*slCols+(slCols-pkCols+1);
{Amount to change pkFirst by when scrolling (not used)}
pkScroll := 1;
{$IFDEF UseScrollBars}
{Set up for scroll bars}
ChangeAllScrollBars(1, slCols, 1, pkItemRows);
{$ENDIF}
end;
end;
{$IFDEF UseScrollBars}
procedure UpdScrollSpread(P : PickListPtr);
{-Update scroll bars}
begin
with SpreadListPtr(P)^ do
DrawAllSliders(GetItemCol(pkFirst)+pkCol-1, GetItemRow(pkFirst)+pkRow-1);
end;
procedure SetScrollSpread(FramePos : FramePosType;
MPosX, MPosY : Byte;
UserVal : LongInt; P : PickListPtr);
{-Set pick position based on slider position}
var
FirstRow : Word;
FirstCol : Word;
begin
with SpreadListPtr(P)^ do begin
case FramePos of
frLL, frRR : {Vertical scroll bar}
begin
UserVal := TweakSlider(FramePos, MPosY, UserVal, 1);
FirstRow := GetItemRow(pkFirst);
if UserVal < FirstRow then begin
dec(pkFirst, (FirstRow-UserVal)*slCols);
FirstRow := UserVal;
end else if UserVal > FirstRow+pkHeight-1 then begin
inc(pkFirst, (UserVal-FirstRow-pkHeight+1)*slCols);
inc(FirstRow, UserVal-FirstRow-pkHeight+1);
end;
pkRow := UserVal-FirstRow+1;
end;
else {Horizontal scroll bar}
UserVal := TweakSlider(FramePos, MPosX, UserVal, 1);
FirstCol := GetItemCol(pkFirst);
if UserVal < FirstCol then begin
dec(pkFirst, FirstCol-UserVal);
FirstCol := UserVal;
end else if UserVal > FirstCol+pkCols-1 then begin
inc(pkFirst, UserVal-FirstCol-pkCols+1);
FirstCol := UserVal-pkCols+1;
end;
pkCol := UserVal-FirstCol+1;
end;
pkChoice := pkGetCurrent(pkFirst, pkRow, pkCol, P);
end;
end;
{$ENDIF}
function ScrolledSpread(pChoice, pFirst : Word; pRow, pCol : Byte;
P : PickListPtr) : Boolean;
{-Perform a one-element optimized scroll if possible}
begin
with SpreadListPtr(P)^ do begin
ScrolledSpread := True;
if pFirst+slCols = pkFirst then
pkScrollDown(pChoice, pRow, pCol)
else if pkFirst+slCols = pFirst then
pkScrollUp(pChoice, pRow, pCol)
else if pFirst+1 = pkFirst then
pkScrollRight(pChoice, pRow, pCol)
else if pkFirst+1 = pFirst then
pkScrollLeft(pChoice, pRow, pCol)
else
ScrolledSpread := False;
end;
end;
procedure PickSpread(P : PickListPtr);
{-Orientation initialization for spreadsheet-like picklists}
begin
with SpreadListPtr(P)^ do begin
pkOrient := pkSpread;
pkGetCurrent := GetSpread;
pkSetCurrent := SetSpread;
pkReinit := ReinitSpread;
{$IFDEF UseScrollBars}
pkUpdScrBar := UpdScrollSpread;
pkSetScroll := SetScrollSpread;
{$ENDIF}
pkScrolled := ScrolledSpread;
end;
end;
function SpreadList.GetItemRow(Item : Word) : Word;
begin
GetItemRow := (Item+slCols-1) div slCols;
end;
function SpreadList.GetItemCol(Item : Word) : Word;
begin
GetItemCol := ((Item-1) mod slCols)+1;
end;
function SpreadList.GetItemNum(Row, Col : Word) : Word;
begin
GetItemNum := (Row-1)*slCols+Col;
end;
procedure SpreadList.TopLeftRowCol(var Row, Col : Word);
begin
Row := GetItemRow(pkFirst);
Col := GetItemCol(pkFirst);
end;
procedure SpreadList.pkInitPickSize1; {virtual;}
var
Wid : Byte;
begin
if pkReqdWidth > pkWidth then
{Clip width as required by window size}
pkItemWidth := pkWidth
else
pkItemWidth := pkReqdWidth;
{Compute number of columns of items, and number of items in each column}
if pkDividers then
Wid := pkWidth+1
else
Wid := pkWidth;
pkCols := Wid div pkItemWidth;
pkItemRows := slRows;
{Limit rows as appropriate}
if pkItemRows < 1 then
pkItemRows := 1;
if pkHeight > pkMaxRows then
pkHeight := pkMaxRows;
if pkHeight > pkItemRows then
pkHeight := pkItemRows;
end;
function SpreadList.pkProcessCursorCommand(var Cmd : Word) : Boolean; {virtual;}
var
Row : Word;
Bot : Word;
Col : Word;
begin
pkProcessCursorCommand := False;
case Cmd of
ccNone : {Nothing}
Exit;
ccUp : {Up}
if pkRow > 1 then
Dec(pkRow)
else begin
Row := GetItemRow(pkFirst);
if FlagIsSet(pkFlags, pkExitAtEdges) and (Row = 1) then begin
Cmd := ccExitAtTop;
pkProcessCursorCommand := True;
end else if (Row > 1) then
dec(pkFirst, slCols);
end;
ccDown : {Down}
if pkRow < pkHeight then
Inc(pkRow)
else begin
Row := GetItemRow(pkFirst);
if FlagIsSet(pkFlags, pkExitAtEdges) and (Row = pkItemRows-pkHeight+1) then begin
Cmd := ccExitAtBot;
pkProcessCursorCommand := True;
end else if (Row < pkItemRows-pkHeight+1) then
inc(pkFirst, slCols);
end;
ccLeft : {Left}
if pkCol > 1 then
Dec(pkCol)
else begin
Col := GetItemCol(pkFirst);
if FlagIsSet(pkFlags, pkExitAtEdges) and (Col = 1) then begin
Cmd := ccExitLeft;
pkProcessCursorCommand := True;
end else if Col > 1 then
dec(pkFirst);
end;
ccRight : {Right}
if pkCol < pkCols then
Inc(pkCol)
else begin
Col := GetItemCol(pkFirst);
if FlagIsSet(pkFlags, pkExitAtEdges) and (Col = slCols-pkCols+1) then begin
Cmd := ccExitRight;
pkProcessCursorCommand := True;
end else if Col < slCols-pkCols+1 then
inc(pkFirst);
end;
ccPageUp : {PgUp}
begin
Row := GetItemRow(pkFirst);
if Row > pkHeight then
dec(pkFirst, slCols*pkHeight)
else if Row = 1 then
pkRow := 1
else
dec(pkFirst, slCols*(Row-1));
end;
ccPageDn : {PgDn}
begin
Row := GetItemRow(pkFirst);
Bot := Row+pkHeight-1;
if Bot+pkHeight <= pkItemRows then
inc(pkFirst, slCols*pkHeight)
else if Bot = pkItemRows then
pkRow := pkHeight
else
inc(pkFirst, slCols*(pkItemRows-Bot));
end;
ccHome : {Left of row}
begin
pkFirst := pkFirst-((pkFirst-1) mod slCols);
pkCol := 1;
end;
ccEnd : {Right of row}
begin
pkFirst := pkFirst-((pkFirst-1) mod slCols)+slCols-pkCols;
pkCol := pkCols;
end;
ccTopOfFile : {Top of sheet}
begin
pkFirst := pkFirst mod slCols;
pkRow := 1;
end;
ccEndOfFile : {End of sheet}
begin
pkFirst := (pkFirst mod slCols)+slCols*(pkItemRows-pkHeight);
pkRow := pkHeight;
end;
end;
pkChoice := pkGetCurrent(pkFirst, pkRow, pkCol, @Self);
end;
constructor SpreadList.Init(X1, Y1, X2, Y2 : Byte;
ItemWidth : Byte;
NumRows : Word;
NumCols : Word;
StringProc : pkStringProc;
CommandHandler : pkGenlProc);
begin
if not SpreadList.InitDeluxe(X1, Y1, X2, Y2,
DefaultColorSet,
DefWindowOptions,
ItemWidth, NumRows, NumCols,
StringProc, CommandHandler,
DefPickOptions) then
Fail;
end;
constructor SpreadList.InitCustom(X1, Y1, X2, Y2 : Byte;
var Colors : ColorSet;
Options : LongInt;
ItemWidth : Byte;
NumRows : Word;
NumCols : Word;
StringProc : pkStringProc;
CommandHandler : pkGenlProc);
begin
if not SpreadList.InitDeluxe(X1, Y1, X2, Y2,
Colors,
Options,
ItemWidth, NumRows, NumCols,
StringProc, CommandHandler,
DefPickOptions) then
Fail;
end;
constructor SpreadList.InitAbstract(X1, Y1, X2, Y2 : Byte;
var Colors : ColorSet;
Options : LongInt;
ItemWidth : Byte;
NumRows : Word;
NumCols : Word;
CommandHandler : pkGenlProc);
begin
if not SpreadList.InitAbstractDeluxe(X1, Y1, X2, Y2,
Colors, Options,
ItemWidth, NumRows, NumCols,
CommandHandler,
DefPickOptions) then
Fail;
end;
constructor SpreadList.InitDeluxe(X1, Y1, X2, Y2 : Byte;
var Colors : ColorSet;
Options : LongInt;
ItemWidth : Byte;
NumRows : Word;
NumCols : Word;
StringProc : pkStringProc;
CommandHandler : pkGenlProc;
PickOptions : Word);
var
NumItems : LongInt;
begin
{Validate the number of items}
NumItems := LongInt(NumRows)*NumCols;
if (NumItems = 0) or (NumItems > 65535) then begin
InitStatus := epFatal+ecBadParam;
Fail;
end;
{Save the rows and columns}
slRows := NumRows;
slCols := NumCols;
{Initialize it}
if not PickList.InitDeluxe(X1, Y1, X2, Y2, Colors, Options, ItemWidth,
NumItems, StringProc, PickSpread,
CommandHandler, PickOptions) then
Fail;
end;
constructor SpreadList.InitAbstractDeluxe(X1, Y1, X2, Y2 : Byte;
var Colors : ColorSet;
Options : LongInt;
ItemWidth : Byte;
NumRows : Word;
NumCols : Word;
CommandHandler : pkGenlProc;
PickOptions : Word);
begin
if not SpreadList.InitDeluxe(X1, Y1, X2, Y2,
Colors, Options,
ItemWidth, NumRows, NumCols,
NoPickString,
CommandHandler, DefPickOptions) then
Fail;
end;
procedure SpreadList.ChangeNumItems(NumItems : Word);
begin
RunError(211);
end;
procedure SpreadList.ChangeOrientation(Orientation : pkGenlProc);
begin
RunError(211);
end;
{$IFDEF UseStreams}
constructor SpreadList.Load(var S : IdStream);
begin
if not PickList.Load(S) then
Fail;
S.Read(slRows, 2*SizeOf(Word));
if S.PeekStatus <> 0 then begin
Done;
Fail;
end;
end;
procedure SpreadList.Store(var S : IdStream);
begin
{Store the underlying pick list}
PickList.Store(S);
if S.PeekStatus <> 0 then
Exit;
{Store what's unique to the spread list}
S.Write(slRows, 2*SizeOf(Word));
end;
procedure SpreadListStream(SPtr : IdStreamPtr);
begin
with SPtr^ do begin
PickListStream(SPtr);
RegisterType(otSpreadList, veSpreadList, TypeOf(SpreadList),
@SpreadList.Store, @SpreadList.Load);
{Register the orientation routine, since there's only one}
RegisterPointer(ptPickSpread, @PickSpread);
end;
end;
{$ENDIF}
{$IFDEF InitAllUnits}
begin
{$ENDIF}
end.